home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / ldb / alloc.c < prev    next >
C/C++ Source or Header  |  1991-11-06  |  3KB  |  123 lines
  1. /* $Header: alloc.c,v 1.7 91/10/22 18:36:50 wlott Exp $ */
  2. #include "lisp.h"
  3. #include "ldb.h"
  4. #include "alloc.h"
  5. #include "globals.h"
  6.  
  7. #ifdef ibmrt
  8. #define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER))
  9. #define SET_FREE_POINTER(new_value) \
  10.     (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value)))
  11. #define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER))
  12. #define SET_GC_TRIGGER(new_value) \
  13.     (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value)))
  14. #else
  15. #define GET_FREE_POINTER() current_dynamic_space_free_pointer
  16. #define SET_FREE_POINTER(new_value) \
  17.     (current_dynamic_space_free_pointer = (new_value))
  18. #define GET_GC_TRIGGER() current_auto_gc_trigger
  19. #define SET_GC_TRIGGER(new_value) \
  20.     clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
  21. #endif
  22.  
  23.  
  24.  
  25. /****************************************************************
  26. Allocation Routines.
  27. ****************************************************************/
  28.  
  29. static lispobj *alloc(bytes)
  30. int bytes;
  31. {
  32.     lispobj *result;
  33.  
  34.     /* Round to dual word boundry. */
  35.     bytes = (bytes + lowtag_Mask) & ~lowtag_Mask;
  36.  
  37.     result = GET_FREE_POINTER();
  38.     SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
  39.  
  40.     if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
  41.     SET_GC_TRIGGER((char *)GET_FREE_POINTER()
  42.                - (char *)current_dynamic_space);
  43.     }
  44.  
  45.     return result;
  46. }
  47.  
  48. lispobj *alloc_unboxed(type, words)
  49. int type, words;
  50. {
  51.     lispobj *result;
  52.  
  53.     result = alloc((1 + words) * sizeof(lispobj));
  54.  
  55.     *result = (lispobj) (words << type_Bits) | type;
  56.  
  57.     return result;
  58. }
  59.  
  60. lispobj alloc_vector(type, length, size)
  61. int type, length, size;
  62. {
  63.     struct vector *result;
  64.  
  65.     result = (struct vector *)alloc((2 + (length*size + 31) / 32) * sizeof(lispobj));
  66.  
  67.     result->header = type;
  68.     result->length = fixnum(length);
  69.  
  70.     return ((lispobj)result)|type_OtherPointer;
  71. }
  72.  
  73. lispobj alloc_cons(car, cdr)
  74. lispobj car, cdr;
  75. {
  76.     struct cons *ptr = (struct cons *)alloc(sizeof(struct cons));
  77.  
  78.     ptr->car = car;
  79.     ptr->cdr = cdr;
  80.  
  81.     return (lispobj)ptr | type_ListPointer;
  82. }
  83.  
  84. lispobj alloc_number(n)
  85. long n;
  86. {
  87.     struct bignum *ptr;
  88.  
  89.     if (-0x20000000 < n && n < 0x20000000)
  90.         return fixnum(n);
  91.     else {
  92.         ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1);
  93.  
  94.         ptr->digits[0] = n;
  95.  
  96.     return (lispobj) ptr | type_OtherPointer;
  97.     }
  98. }
  99.  
  100. lispobj alloc_string(str)
  101. char *str;
  102. {
  103.     int len = strlen(str);
  104.     lispobj result = alloc_vector(type_SimpleString, len+1, 8);
  105.     struct vector *vec = (struct vector *)PTR(result);
  106.  
  107.     vec->length = fixnum(len);
  108.     strcpy(vec->data, str);
  109.  
  110.     return result;
  111. }
  112.  
  113. lispobj alloc_sap(ptr)
  114. char *ptr;
  115. {
  116.     struct sap *sap = (struct sap *)alloc_unboxed(type_Sap, 1);
  117.  
  118.     sap->pointer = ptr;
  119.  
  120.     return (lispobj) sap | type_OtherPointer;
  121. }
  122.  
  123.